home *** CD-ROM | disk | FTP | other *** search
/ Light ROM 4 / Light ROM 4 - Disc 1.iso / text / net_news / 1994 / 1.doc / text0222.txt < prev    next >
Encoding:
Text File  |  1995-03-24  |  4.3 KB  |  192 lines
  1. Here is the revised curvetext.lwm as mentioned - just "cut out and keep":
  2.  
  3. BTW, I'm working on the proportional spacing problem...
  4.  
  5. /* Curve Text
  6.  * Based on a macro Arnie Cachelin
  7.  * By Simon Coombs 1994 RSTV */
  8.  
  9. libadd = addlib("LWModelerARexx.port",0)
  10. signal on error
  11. signal on syntax
  12.  
  13. call addlib "rexxsupport.library", 0, -30, 0
  14. MATHLIB="rexxmathlib.library"
  15. IF POS(MATHLIB , SHOW('L')) = 0 THEN
  16.   IF ~ADDLIB(MATHLIB , 0 , -30 , 0) THEN DO
  17.     call notify(1,"!Can't find "MATHLIB)
  18.     exit
  19.     END
  20. sysnam = 'Build Curved Text'
  21. filnam = 'ENV:CurveText.state'
  22. version = 'Curved Text v1.0'
  23.  
  24. lines=2
  25. rad=3
  26. arng=.6
  27. styles = 'Flat Block Chisel Round'
  28. typ=1
  29. deep = 0.1
  30. wide = 0.02
  31. call req_begin sysnam
  32. id_font = req_addcontrol("Use Font",'F')
  33. id_typ = req_addcontrol("Text Type", "CH",Styles)
  34. id_deep = req_addcontrol("Depth", 'n', 1)
  35. id_wide = req_addcontrol("Edge Width", 'n', 1)
  36. RadId = req_addcontrol("Radius",'N',0)
  37. TxtId = req_addcontrol("Text",'S',35)
  38. angId = req_addcontrol("Spacing",'N',0)
  39. axId = req_addcontrol("Axis", "CH",'X Y Z')
  40. surfid = req_addcontrol("Surface",'R')
  41.  
  42. call req_setval RadId, rad
  43. call req_setval TxtId, ""
  44. call req_setval id_typ, typ,1
  45. call req_setval id_deep, deep,0.1
  46. call req_setval id_wide, wide,0.02
  47. call req_setval angId, arng,0
  48. call req_setval axId, 3
  49.  
  50. if (~req_post()) then do
  51.   call req_end
  52.   exit
  53.   end
  54. font = req_getval(id_font)
  55. rad = req_getval(RadId)
  56. txt = req_getval(TxtId)
  57. arng = req_getval(angId)
  58. ax = req_getval(axId)
  59. name = req_getval(surfId)
  60. typ = req_getval(id_typ)
  61. wide = req_getval(id_wide)
  62. if typ = 1 then deep = 0
  63. else deep = req_getval(id_deep)
  64. call req_end
  65.  
  66. call CUT()
  67. /*font=fontload(fntname)*/
  68. if font=0 then do
  69.   if(notify(2,"!Please Load A Font!")) then do
  70.     fname=GetFileName("Load Font","/Fonts")
  71.     if fname~="(none)" then do
  72.       font=fontload(fname)
  73.       if font=0 then do
  74.         call notify(1,"!Can't load font "fname)
  75.         exit
  76.         end
  77.       end
  78.     end
  79.   end
  80.  
  81. LetSiz=MAKETEXT('M', font)  /* One emm space (M width)  */
  82. box=boundingbox()  /* Should check out empty list ...  */
  83. if LetSiz~=0 then call UNDO() /* Get rid of M  */
  84. parse var box n x1 x2 y1 y2 z1 z2
  85. if ax=1 then LetSiz=1.5*abs(y2-y1)
  86. call 'PASTE'
  87. L= length(txt)
  88. astep=(1+4*arng)*36*LetSiz/(-3.141592*rad)    /* Do this in loop to use PS kerning!! */
  89. angle=-astep
  90. call SURFACE(name)
  91. do i=1 to L
  92.   if ax=1 then call ROTATE(astep,'X',0)
  93.   else if ax=2 then call ROTATE(astep,'Y',0)
  94.   else call ROTATE(astep,'Z',0)
  95.   angle=angle+astep
  96.   call CUT()
  97.   c=substr(txt,i,1)
  98.   cw=maketext(c,font)
  99.   h=centerx()
  100.   if ax=1 then call MOVE(0 0 rad*(-1))
  101.   else if ax=2 then call MOVE(0 0 rad*(-1))
  102.   else  call MOVE(0 rad 0)
  103.   call PASTE()
  104.   end
  105. if ax=1 then call ROTATE(Angle/(-2),'X',0)
  106. else if ax=2 then call ROTATE(Angle/(-2),'Y',0)
  107. else call ROTATE(Angle/(-2),'Z',0)
  108. call ShapeText(typ)
  109. if (libadd) then call remlib("LWModelerARexx.port")
  110. exit
  111.  
  112. syntax:
  113. error:
  114.   call end_all
  115.     t=Notify(1,'!Rexx Script Error','@'ErrorText(rc),'Line 'SIGL)
  116.   if (libadd) then call remlib("LWModelerARexx.port")
  117.     exit
  118.  
  119. Center: Procedure
  120.   box=boundingbox()  /* Should check out empty list ...  */
  121.   parse var box n x1 x2 y1 y2 z1 z2
  122.   cx=-(x2+x1)/2
  123.   cy=-(y2+y1)/2
  124.   cz=-(z2+z1)/2
  125.   call MOVE(cx cy cz)
  126.   return box
  127.  
  128. CenterX: Procedure
  129.   arg A
  130.   box=boundingbox()  /* Should check out empty list ...  */
  131.   parse var box n x1 x2 y1 y2 z1 z2
  132.   cx=-(x2-x1)/2
  133.   cy=-(y2-y1)/2
  134.   call MOVE(cx 0 0)
  135.   return 2*cy
  136.  
  137. Bevel_Flat:
  138.   return
  139.  
  140. Bevel_Block:
  141.   call bevel(0, deep / 2)
  142.   return
  143.  
  144. Bevel_Chisel:
  145.   call shapebevel(-wide wide (-wide) deep/2)
  146.   return
  147.  
  148. Bevel_Round:
  149.   n = 5
  150.   pat = ''
  151.   do i=1 to n
  152.     a = 3.14159/2 * i / n
  153.     pat = pat (-sin(a)*wide) (1-cos(a))*wide
  154.     end i
  155.   call shapebevel(pat (-wide) deep/2)
  156.   return
  157.  
  158. ShapeText: PROCEDURE expose wide styles deep
  159.   arg typ
  160.   sl1 = curlayer()
  161.   empty = emptylayers()
  162.   if (words(empty) < 1) then do
  163.     call notify 1,syscode,"!Need an empty layer","!for this operation."
  164.     exit
  165.     end
  166.   sl2 = word(empty, 1)
  167.   call copy
  168.   sbase=cursurface()
  169.   call setlayer sl2
  170.   call paste
  171.   call flip
  172.   call sel_mode('user')
  173.   call sel_polygon('set')
  174.   interpret 'call Bevel_' || word(styles, typ)
  175.   call cut
  176.   call changesurface(sbase || "_Side")
  177.   call paste
  178.   call setlayer sl1 /* Get the correct faces from sl1. */
  179.   call changesurface(sbase|| "_Face")
  180.   call cut
  181.   call setlayer sl2
  182.   call paste
  183.   call mergepoints
  184.   call cut
  185.   call setlayer sl1
  186.   call paste
  187.   return
  188. /* That's all folks! */
  189.  
  190.  
  191.  
  192.